perm filename CYCDRJ.PRT[4,LMM] blob sn#037528 filedate 1973-04-23 generic text, type T, neo UTF8
  (DEFPROP CYCDRJFNS (CYCDRJFNS ISOMERS RING DRAW LABELLER)
           VALUE)
  (DEFPROP
    ISOMERS
    (LAMBDA
      NIL
      (PROG
        (CL U)
        CLLP
        (PRINT (QUOTE CL?))
        (SETQ CL (READ))
        (COND ((ATOM CL)
               (PRINC (QUOTE "THAT CAN'T BE RIGHT - ENTER A "))
               (GO CLLP)))
        (COND
          ((FOR NEW PR IN CL OR
                (OR (ATOM PR)
                    (NOT (NUMBERP (CDR PR)))
                    (NOT (ATOM (CAR PR)))
                    (NOT (OR (NUMBERP (GET (CAR PR)
                                           (QUOTE VALENCE)))
                             (PROG2 (TERPRI)
                                    (PRINC (QUOTE 
                                           "WHAT'S THE VALENCE OF "))
                                    (PRINC (CAR PR))
                                    (PRINC (QUOTE ?))
                                    (NUMBERP (PUTPROP (CAR PR)
                                                      (READ)
                                                      (QUOTE VALENCE))))
                             ))))
           (GO CLLP)))
        ULP
        (PRINT (QUOTE U?))
        (COND ((NOT (NUMBERP (SETQ U (READ))))
               (GO ULP)))
        (SETQ RESULTS (MOLECULES CL U))
        (PRINT (LIST (LENGTH RESULTS)
                     (QUOTE STRUCTURES)
                     (QUOTE GENERATED)))))
    EXPR)
  (DEFPROP
    RING
    (LAMBDA
      NIL
      (PROG
        (CL U)
        CLLP
        (PRINT (QUOTE CL?))
        (SETQ CL (READ))
        (COND ((ATOM CL)
               (PRINC (QUOTE "THAT CAN'T BE RIGHT - ENTER A "))
               (GO CLLP)))
        (COND
          ((FOR NEW PR IN CL OR
                (OR (ATOM PR)
                    (NOT (NUMBERP (CDR PR)))
                    (NOT (ATOM (CAR PR)))
                    (NOT (OR (NUMBERP (GET (CAR PR)
                                           (QUOTE VALENCE)))
                             (PROG2 (TERPRI)
                                    (PRINC (QUOTE 
                                           "WHAT'S THE VALENCE OF "))
                                    (PRINC (CAR PR))
                                    (PRINC (QUOTE ?))
                                    (NUMBERP (PUTPROP (CAR PR)
                                                      (READ)
                                                      (QUOTE VALENCE))))
                             ))))
           (GO CLLP)))
        ULP
        (PRINT (QUOTE U?))
        (COND ((NOT (NUMBERP (SETQ U (READ))))
               (GO ULP)))
        (SETQ RESULTS (RINGS U CL))
        (PRINT (LIST (LENGTH RESULTS)
                     (QUOTE STRUCTURES)
                     (QUOTE GENERATED)))))
    EXPR)
  (DEFPROP DRAW
           (LAMBDA (N)
                   (PROG (S)
                         (COND ((GREATERP N (LENGTH RESULTS))
                                (PRINT (QUOTE (NOT THAT MANY STRUCTURES 
                                                   -- TRY AGAIN!!!))))
                               ((STRUCTURE? (SETQ S
                                                  (CAR (NTH RESULTS N)))
                                            )
                                (DRAWS S NIL))
                               (T (SETQ TITLE (LIST (QUOTE STRUCTURE#)
                                                    N))
                                  (PRINRAD S)))))
           EXPR)
  (DEFPROP
    LABELLER
    (LAMBDA
      NIL
      (PROG
        (CL U)
        CLLP
        (TERPRI)
        (PRINC (QUOTE "ATOMS TO BE LABELLED?"))
        (SETQ CL (READ))
        (COND ((ATOM CL)
               (PRINC (QUOTE "THAT CAN'T BE RIGHT - ENTER A "))
               (GO CLLP)))
        (COND
          ((FOR NEW PR IN CL OR
                (OR (ATOM PR)
                    (NOT (NUMBERP (CDR PR)))
                    (NOT (ATOM (CAR PR)))
                    (NOT (OR (NUMBERP (GET (CAR PR)
                                           (QUOTE VALENCE)))
                             (PROG2 (TERPRI)
                                    (PRINC (QUOTE 
                                           "WHAT'S THE VALENCE OF "))
                                    (PRINC (CAR PR))
                                    (PRINC (QUOTE ?))
                                    (NUMBERP (PUTPROP (CAR PR)
                                                      (READ)
                                                      (QUOTE VALENCE))))
                             ))))
           (GO CLLP)))
        ULP
        (PRINT (QUOTE U?))
        (COND ((NOT (NUMBERP (SETQ U (READ))))
               (GO ULP)))
        (SETQ RESULTS (MOLECULES CL U))
        (PRINT (LIST (LENGTH RESULTS)
                     (QUOTE STRUCTURES)
                     (QUOTE GENERATED)))))
    EXPR)
STOP